home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / modula2 / drucker / lpr / install.mod < prev    next >
Encoding:
Modula Implementation  |  1994-09-22  |  14.0 KB  |  356 lines
  1. IMPLEMENTATION MODULE Install;
  2.  
  3. (************************************************************************
  4.  * Install-Modul für LPR-Modula2-Druckertreiber                         *
  5.  *                                                                      *
  6.  * (c) 9/1989 by Uwe Ischebeck, Ringstr.31, 6900 Heidelberg             *
  7.  *                                                                      *
  8.  * Beschreibung im DEF-Modul                                            *
  9.  ************************************************************************)
  10.  
  11. IMPORT GEMDOS;
  12.  
  13. IMPORT Heap;
  14.  
  15. FROM SYSTEM IMPORT ADR, LONG, SHORT;
  16.  
  17. VAR anzahl : LONGINT;
  18.     CRLF : ARRAY[0..1] OF CHAR;
  19.     ZeilenLaenge : INTEGER;    
  20.  
  21. PROCEDURE Sloeschen;
  22.   VAR i:INTEGER;
  23.   BEGIN
  24.     S.LQ:=FALSE;                     (* LQ-flag löschen          *)
  25.     FOR i:=0 TO MaxFunc DO           (* Codetabelle löschen      *)
  26.       S.c[i]:=0 END;
  27.     FOR i:=0 TO 255 DO               (* Zeichentabelle löschen   *)
  28.       S.z[i]:=0 END;
  29.     S.n:=NIL;                        (* Zeiger auf Namen löschen *)
  30.     S.geladen:=FALSE;                (* keine Anpassung geladen  *)
  31.   END Sloeschen;
  32.     
  33.  
  34. PROCEDURE ConfigPrinter( GemdosPrnOutHandle : INTEGER; 
  35.                          name : ARRAY OF CHAR );
  36.   VAR i, num, FileHandle : INTEGER;
  37.       anzahl : LONGINT;
  38.       ok : BOOLEAN;
  39.   BEGIN
  40.     ok:=FALSE;
  41.     Sloeschen;                          (* Löschen aller Tabellen    *)
  42.     i:=0;                               (* Name der CFG-Datei in die *)
  43.     WHILE (i<=HIGH(S.d)) & (i<=HIGH(name)) DO 
  44.       S.d[i]:=name[i];                  (* Tabelle kopieren          *)
  45.       INC(i);               
  46.     END;
  47.     GEMDOS.Open(S.d,0,FileHandle);       (* CFG-Datei öffnen         *)
  48.     CfgError:=GEMDOS.ErrorNo;
  49.     IF (CfgError=0) AND (FileHandle<0) THEN CfgError:=FileHandle END;
  50.     IF CfgError=0 THEN
  51.       anzahl:=SIZE(S.a);                 (* Datei einlesen           *)
  52.       GEMDOS.Read( FileHandle, anzahl, ADR(S.a) );
  53.       CfgError:=GEMDOS.ErrorNo;
  54.       IF CfgError=0 THEN
  55.         IF GemdosPrnOutHandle>=0 THEN    (* Ausgabehandle festlegen  *)
  56.           S.filehandle:=GemdosPrnOutHandle END;
  57.         i:=0;
  58.         WHILE (S.a[i]#0C) & (i<80) DO    (* Ende des Namens finden   *)
  59.           INC(i) END;                    (* (durch 0C terminiert)    *)
  60.         IF i<80 THEN                     (* i<80: Namensende gefunden *)
  61.           S.n:=ADR(S.a[8]);              (* Name beginnt an 8.Stelle *)
  62.           INC(i);                        (* 0C überspringen          *)
  63.           FOR num:=0 TO 5 DO             (* Config-Parameter         *)
  64.             S.par[num]:=S.a[i];          (* übertragen               *)
  65.             INC(i)
  66.            END;
  67.           WHILE S.a[i]#0C DO             (* Funktionstabelle 0-terminiert *)
  68.             num:=ORD(S.a[i+1]);          (* FktNummer an 2.Stelle,   *)
  69.             S.c[num]:=i;                 (* FktLänge an 1.Stelle     *)
  70.             i:=i+ORD(S.a[i]);            (* nächste Fkt              *)
  71.           END (* Funktionen festlegen *);
  72.           INC(i);                        (* 0hex überspringen        *)
  73.           WHILE S.a[i]#0C DO             (* Zeichentabelle 0-terminiert *)
  74.             num:=ORD(S.a[i+1]);          (* Aufbau wie Fkt-Tabelle   *)
  75.             S.z[num]:=i;
  76.             i:=i+ORD(S.a[i]);            (* nächstes Zeichen         *)
  77.           END (* Zeichentabelle festlegen *);
  78.           S.geladen:=TRUE;               (* Flag "Anpassung geladen" *)
  79.         END (* IF i<80 (Wahrscheinlichkeit für CFG-Datei groß) *)
  80.       END (* IF file read *);
  81.       ok:=GEMDOS.Close(FileHandle);
  82.     END (* IF file opened *);
  83.   END ConfigPrinter;
  84.  
  85. PROCEDURE PrintHandle( handle : INTEGER );
  86.   BEGIN
  87.     IF handle>=0 THEN S.filehandle:=handle END; 
  88.   END PrintHandle;
  89.   
  90. PROCEDURE PrintDirektString( str : ARRAY OF CHAR );
  91.   VAR l : INTEGER;
  92.   BEGIN
  93.     l:=0;
  94.     LOOP (* Wie lang ist "str", da evtl. nicht mit 0C terminiert *)
  95.       IF l>HIGH(str) THEN EXIT
  96.       ELSIF str[l]=0C THEN EXIT
  97.       ELSE INC(l) 
  98.       END
  99.     END;
  100.     ZeilenLaenge:=ZeilenLaenge+l;
  101.     anzahl:=LONG(l);
  102.     GEMDOS.Write(S.filehandle,anzahl,ADR(str) ); (* Ausgabe *)
  103.   END PrintDirektString;
  104.   
  105. PROCEDURE PrintDirekt( c : CHAR );
  106.   BEGIN
  107.     IF c>37C THEN INC(ZeilenLaenge) END;
  108.     anzahl:=1;
  109.     GEMDOS.Write(S.filehandle,anzahl,ADR(c) );
  110.   END PrintDirekt;
  111.   
  112. PROCEDURE PrintDirektLn;
  113.   BEGIN 
  114.     PrintDirektString(CRLF);
  115.     ZeilenLaenge:=0;
  116.   END PrintDirektLn;
  117.   
  118. PROCEDURE IntToHex( ein : INTEGER; VAR aus : ARRAY OF CHAR);
  119.   VAR n,h : INTEGER;
  120.   BEGIN
  121.     n:=HIGH(aus);  (* Setzt die Integerzahl "ein" in die Zeichenkette *)
  122.     WHILE n>=0 DO  (* "aus" rechtsbündig ein. Aufgefüllt mit "0".     *)
  123.       h:=ein MOD 16;
  124.       IF h<10 THEN aus[n]:=CHR(h+30H)
  125.               ELSE aus[n]:=CHR(h+41H-10) END;
  126.       ein:=ein DIV 16; DEC(n);
  127.     END;
  128.   END IntToHex;
  129.   
  130. PROCEDURE CfgAnalyse;
  131.   VAR s2 : ARRAY[0..1] OF CHAR;
  132.       i,n : INTEGER;
  133.   BEGIN
  134.       PrintDirektString("* Name des Druckertreibers"); PrintDirektLn;
  135.       PrintDirektString(S.n^);
  136.       PrintDirektLn;
  137.       PrintDirektLn;
  138.       PrintDirektString("* Installationsvariablen"); PrintDirektLn;
  139.       FOR i:=0 TO 5 DO
  140.         IntToHex(ORD(S.par[i]),s2);
  141.         IF i>0 THEN PrintDirektString(", ") END;
  142.         PrintDirektString(s2);
  143.       END;
  144.       PrintDirektLn;
  145.       PrintDirektLn;
  146.       PrintDirektString("* Druckerfunktionen"); PrintDirektLn;
  147.       FOR i:=1 TO MaxFunc DO
  148.         IF S.c[i]#0 THEN
  149.           IntToHex(i,s2); PrintDirektString(s2);
  150.           FOR n:=2 TO ORD(S.a[S.c[i]])-1 DO
  151.             IntToHex(ORD(S.a[S.c[i]+n]),s2);
  152.             PrintDirektString(", ");  
  153.             IF ZeilenLaenge>=80 THEN PrintDirektLn;
  154.                                      PrintDirektString("- ") END;
  155.             PrintDirektString(s2);
  156.           END;
  157.         ELSE
  158.           PrintDirektString("* ");
  159.           IntToHex(i,s2); PrintDirektString(s2);
  160.           FOR n:=1 TO 25 DO
  161.             PrintDirekt(" ") END;
  162.           PrintDirektString("* unbenutzt");
  163.         END;
  164.         PrintDirektLn;
  165.       END;
  166.       (* Tabelle mit "0" beenden: *)
  167.       PrintDirekt("0"); PrintDirektLn; PrintDirektLn;
  168.       PrintDirektString("* Übersetzungstabelle"); PrintDirektLn;
  169.       FOR i:=0 TO 255 DO
  170.         IF S.z[i]#0 THEN
  171.           IntToHex(i,s2); PrintDirektString(s2);
  172.           FOR n:=2 TO ORD(S.a[S.z[i]])-1 DO
  173.             IntToHex(ORD(S.a[S.z[i]+n]),s2);
  174.             PrintDirektString(", "); 
  175.             IF ZeilenLaenge>=80 THEN PrintDirektLn;
  176.                                      PrintDirektString("- ") END;
  177.             PrintDirektString(s2);
  178.           END;
  179.           FOR n:=1 TO 15-ORD(S.a[S.z[i]]) DO
  180.             PrintDirektString("    ") END;
  181.           PrintDirektString(" * "); PrintDirekt(CHR(i));
  182.           IF ORD(S.a[S.z[i]])=2 THEN 
  183.             PrintDirektString(" nicht verfügbar") END;
  184.           PrintDirektLn;
  185.         END;
  186.       END;
  187.       (* Tabelle mit "0" beenden: *)
  188.       PrintDirekt("0"); PrintDirektLn;
  189.   END CfgAnalyse;
  190.  
  191. PROCEDURE CfgInstall(HexfileName, CfgfileName : ARRAY OF CHAR);
  192.   CONST LASize = 7167;
  193.   TYPE LargeArray = ARRAY[0..LASize] OF CHAR;
  194.   VAR handle, Ttop, Tpos, Tgroesse,
  195.       CfgSize, num, hex, len : INTEGER;
  196.       DateiEnde, ok, zeilenende, hexOk : BOOLEAN;
  197.       T : POINTER TO LargeArray;
  198.       status : ( namelesen, configvariablen, fkttabelle, zeichentabelle,fertig );
  199.       PufferString : ARRAY[0..511] OF CHAR;
  200.  
  201.   PROCEDURE ScanArray(VAR a : ARRAY OF CHAR; VAR i : INTEGER);
  202.     VAR c : CHAR;
  203.         ii : INTEGER;
  204.     
  205.     PROCEDURE Laden;
  206.       BEGIN
  207.         anzahl:=LONG(Tgroesse);            (* Lädt anzahl Bytes in den *)
  208.         GEMDOS.Read(handle,anzahl,ADR(a)); (* Puffer a                 *)
  209.         Tpos:=0; Ttop:=SHORT(anzahl);
  210.         DateiEnde:=Ttop=0;
  211.       END Laden;
  212.     
  213.     PROCEDURE NextC;    (* Zeiger auf das nächste Zeichen setzen. Wenn *)
  214.       BEGIN             (* das Dateiende noch nicht erreicht ist, dann *)
  215.         INC(Tpos);      (* Puffer nachladen.                           *)
  216.         IF Tpos>=Ttop THEN 
  217.           DateiEnde:=Ttop<Tgroesse;
  218.           IF NOT(DateiEnde) THEN Laden END;
  219.         END;
  220.       END NextC;
  221.     
  222.     PROCEDURE SucheNaechsteZeile;
  223.       BEGIN
  224.         LOOP IF DateiEnde THEN EXIT END; (* Zeichen bis Zeilenende *)
  225.              IF a[Tpos]>37C THEN NextC   (* überlesen              *)
  226.                             ELSE EXIT END;     END (* loop *);
  227.         LOOP IF DateiEnde THEN EXIT END; (* ALLE Kontrollzeichen   *)
  228.              IF a[Tpos]<40C THEN NextC   (* ASCII<" " überlesen    *)
  229.                             ELSE EXIT END;     END (* loop *);
  230.         IF a[Tpos]="-" THEN NextC; zeilenende:=DateiEnde
  231.                        ELSE zeilenende:=TRUE END;
  232.       END SucheNaechsteZeile;
  233.       
  234.     PROCEDURE HexZahl(VAR hex:INTEGER; VAR ok : BOOLEAN );
  235.       VAR c:CHAR;
  236.       BEGIN
  237.         ok:=FALSE; hex:=0;
  238.         LOOP
  239.           IF DateiEnde THEN EXIT END;
  240.           c:=a[Tpos]; NextC;
  241.           CASE c OF
  242.             "0".."9": hex:=hex*16+ORD(c)-30H; ok:=TRUE;
  243.           | "A".."F": hex:=hex*16+ORD(c)-37H; ok:=TRUE;
  244.           ELSE EXIT END;
  245.         END (* loop *);
  246.       END HexZahl;
  247.       
  248.     BEGIN
  249.       Laden;
  250.       zeilenende:=FALSE; hex:=0; ok:=FALSE; CfgError:=-72;
  251.       WHILE (i<SIZE(S.a)) & NOT(DateiEnde) DO
  252.         c:=a[Tpos];
  253.         CASE c OF
  254.         0C..37C,"*": SucheNaechsteZeile;
  255.         ELSE
  256.           IF status=namelesen THEN
  257.             IF (c#" ") OR ok THEN               (* Name kopieren, Leer-  *)
  258.               ok:=TRUE; S.a[i]:=c; INC(i) END;  (* zeichen am Anfang ver-*)
  259.             NextC;                              (* schlucken             *)
  260.           ELSE
  261.             CASE c OF
  262.             "0".."9","A".."F":                  (* das muß wohl eine     *)
  263.                  HexZahl(hex,hexOk);            (* Hexzahl sein          *)
  264.                  IF hexOk THEN                  (* wirklich ?            *)
  265.                    IF status=configvariablen THEN
  266.                      IF num<0 THEN num:=0 END;  (* Configparameter fest- *)
  267.                      S.par[num]:=CHR(hex); S.a[i]:=CHR(hex); INC(i);
  268.                      INC(num); ok:=TRUE;        (* -legen,aber nicht mehr *)
  269.                      IF num=6 THEN SucheNaechsteZeile END;  (* als 6      *)
  270.                    ELSE
  271.                      IF num<0 THEN              (* Funktions/Zeichen-Nr  *)
  272.                        num:=hex; ii:=i; INC(i); 
  273.                        IF num>0 THEN 
  274.                          S.a[i]:=CHR(hex); INC(i); len:=2 END; 
  275.                        ok:=TRUE;
  276.                      ELSE
  277.                        S.a[i]:=CHR(hex); INC(len); INC(i);  (* Code     *)
  278.                        IF len=255 THEN SucheNaechsteZeile END;
  279.                      END;
  280.                    END;
  281.                  END (* if hexOk *);
  282.             ELSE NextC END (* case c of 0..9,A..F *);
  283.           END (* if status=namelesen *);
  284.         END; (* case c of 0c..37c *)
  285.         IF zeilenende THEN
  286.           IF ok THEN
  287.             CASE status OF
  288.               zeichentabelle: IF num=0 THEN S.a[ii]:=0C; status:=fertig; 
  289.                                        ELSE S.z[num]:=ii; S.a[ii]:=CHR(len); 
  290.                                        END;        (* Umwandlung fertig *)
  291.             | fkttabelle:     IF num=0 THEN S.a[ii]:=0C; 
  292.                                             status:=zeichentabelle; 
  293.                                        ELSE S.c[num]:=ii; S.a[ii]:=CHR(len); 
  294.                                        END;
  295.                               CfgError:=-75;      (* Fkt-Tabelle fertig *)
  296.             | configvariablen: status:=fkttabelle; CfgError:=-74;
  297.             | namelesen:      S.a[i]:=0C; INC(i); status:=configvariablen;
  298.                               CfgError:=-73;
  299.             ELSE
  300.             END (* case status of *) ;
  301.           END (* if ok *);
  302.           hex:=0; num:=-1; ok:=FALSE;
  303.           zeilenende:=FALSE;                (* jetzt die nächste Zeile *)
  304.         END (* if zeilenende *);
  305.         IF i>=SIZE(S.a) THEN CfgError:=EBuffOv END;
  306.       END (* while not(dateiende) *);
  307.       IF status=fertig THEN CfgError:=0 END;      (* hat wohl geklappt *)
  308.     END ScanArray;
  309.     
  310.   BEGIN
  311.     Sloeschen; CfgError:=0;
  312.     GEMDOS.Open(HexfileName,0,handle);
  313.     IF handle>=0 THEN
  314.       Tgroesse:=16;                   (* Versuch, den Puffer so     *)
  315.       REPEAT                          (* groß wie möglich zu machen *)
  316.         anzahl:=LONG(Tgroesse*1024);
  317.         Heap.Allocate(T,anzahl);
  318.         IF T=NIL THEN DEC(Tgroesse) END;
  319.       UNTIL (T#NIL) OR (Tgroesse=0);
  320.       IF T=NIL THEN                  (* nichteinmal 1kB angelegt *)
  321.         Tgroesse:=SIZE(PufferString); T:=ADR(PufferString);
  322.       ELSE                           (* mindestens 1kB angelegt  *)
  323.         Tgroesse:=Tgroesse*1024;
  324.       END;
  325.       status:=namelesen;
  326.       S.a:="GST-CFG:";                  (* WordPlus will das so. *)
  327.       CfgSize:=8; S.n:=ADR(S.a[8]);
  328.       ScanArray(T^,CfgSize);            (* Dann wandle doch mal  *)
  329.       ok:=GEMDOS.Close(handle);
  330.       IF Tgroesse>512 THEN              (* Wenn ein Puffer ange- *)
  331.         anzahl:=LONG(Tgroesse);         (* legt wurde, muß er    *)
  332.         Heap.Deallocate(T,anzahl);      (* auch wieder           *)
  333.       END;                              (* freigegeben werden.   *)
  334.       IF (CfgSize<=8) THEN CfgError:=-77 END; (* war wohl doch nix *)
  335.       IF CfgError=0 THEN                      (* wenn's geklappt hat, *)
  336.         GEMDOS.SFirst(CfgfileName,0,handle);  (* dann CFG abspeichern *)
  337.         IF handle=0 THEN ok:=GEMDOS.Delete(CfgfileName) END;
  338.         GEMDOS.Create(CfgfileName,0,handle);
  339.         IF handle>=0 THEN
  340.           anzahl:=LONG(CfgSize);
  341.           GEMDOS.Write(handle,anzahl,ADR(S.a));
  342.           ok:=GEMDOS.Close(handle);
  343.         ELSE CfgError:=handle END;
  344.       END;
  345.     ELSE
  346.       CfgError:=handle; (* hab' die Datei nicht gefunden *)
  347.     END;
  348.   END CfgInstall;
  349.  
  350. BEGIN   
  351.   S.filehandle:=3;         (* Initialisieren *)
  352.   S.geladen:=FALSE;
  353.   CRLF[0]:=15C; CRLF[1]:=12C;
  354.   ZeilenLaenge:=0;
  355. END Install.
  356.